Ejercicio_Provincias

EJERCICIO DE EVALUACIÓN I

ANÁLISIS DE COMPONENTES PRINCIPALES Y CLUSTER

1.Calcular la matriz de correlaciones, y su representación gráfica ¿Cuáles son las variables más correlacionadas de forma inversa?

Provincias<- read_excel("Provincias.xlsx",sheet = 1) 
datos<- as.data.frame(Provincias) 
rownames(datos)<-datos[,1] 
datos<-datos[,-1]
Est<-stat.desc(datos,basic=FALSE)
knitr::kable(Est, digits =2,caption = "Estadísticos descriptivos")

Estadísticos descriptivos

	Poblacion	Mortalidad	Natalidad	IPC	NumEmpresas	Industria	Construccion	CTH	Infor	AFS	APT	TasaActividad	TasaParo	Ocupados	PIB	CANE	TVF	VS
median	6.147230e+05	9.12	8.98	102.32	3.800000e+04	2516.00	5070.00	15488.00	369.50	813.50	5440.50	57.79	19.51	222.40	1.188364e+07	14037.00	3.359340e+05	5.641150e+04
mean	8.994489e+05	9.38	8.84	102.35	6.128612e+04	3807.77	7804.79	23741.21	1131.88	1378.31	10853.50	57.84	21.17	347.09	2.027514e+07	19034.54	4.847812e+05	7.079935e+04
SE.mean	1.600722e+05	0.29	0.30	0.11	1.255286e+04	669.75	1452.44	4184.44	413.68	286.83	2829.49	0.56	0.97	67.43	4.544660e+06	1978.57	7.458945e+04	8.016740e+03
CI.mean.0.95	3.213584e+05	0.59	0.60	0.23	2.520092e+04	1344.58	2915.90	8400.61	830.50	575.85	5680.44	1.13	1.94	135.38	9.123786e+06	3972.14	1.497446e+05	1.609428e+04
var	1.332402e+12	4.50	4.57	0.67	8.193867e+09	23325284.46	109698956.01	910495895.62	8898914.50	4278261.00	416313032.73	16.34	48.59	236460.60	1.074005e+15	203565500.80	2.893064e+11	3.341943e+09
std.dev	1.154297e+06	2.12	2.14	0.82	9.051998e+04	4829.63	10473.73	30174.42	2983.10	2068.40	20403.75	4.04	6.97	486.27	3.277201e+07	14267.64	5.378721e+05	5.780954e+04
coef.var	1.280000e+00	0.23	0.24	0.01	1.480000e+00	1.27	1.34	1.27	2.64	1.50	1.88	0.07	0.33	1.40	1.620000e+00	0.75	1.110000e+00	8.200000e-01

De los estadísticos mostrados observamos que existe bastante dispersión entre las provincias.

xyplot(PIB ~ TasaActividad, data =datos)

xyplot(PIB ~ IPC, data =datos)

xyplot(PIB ~ NumEmpresas, data =datos)

Sólo vemos una clara relación de tipo directo entre el número de empresas y el PIB. Con la tasa de actividad y el IPC vemos que hay relación directa también pero quizá los casos atípicos no nos permitan verla con mayor claridad.

R<-cor(datos, method="pearson")
knitr::kable(R, digits =2,caption = "Correlaciones")

Correlaciones

	Poblacion	Mortalidad	Natalidad	IPC	NumEmpresas	Industria	Construccion	CTH	Infor	AFS	APT	TasaActividad	TasaParo	Ocupados	PIB	CANE	TVF	VS
Poblacion	1.00	-0.34	0.11	0.33	0.99	0.96	0.98	1.00	0.94	0.99	0.98	0.33	0.01	1.00	0.98	0.10	0.99	0.57
Mortalidad	-0.34	1.00	-0.74	0.19	-0.31	-0.28	-0.30	-0.33	-0.26	-0.31	-0.30	-0.73	-0.46	-0.33	-0.30	0.02	-0.33	-0.25
Natalidad	0.11	-0.74	1.00	-0.25	0.11	0.09	0.09	0.10	0.11	0.10	0.11	0.47	0.38	0.11	0.11	-0.12	0.08	-0.03
IPC	0.33	0.19	-0.25	1.00	0.36	0.42	0.40	0.36	0.30	0.32	0.33	0.09	-0.58	0.36	0.36	-0.19	0.34	0.19
NumEmpresas	0.99	-0.31	0.11	0.36	1.00	0.97	0.99	0.99	0.96	0.99	0.99	0.33	-0.06	1.00	0.99	0.04	0.98	0.54
Industria	0.96	-0.28	0.09	0.42	0.97	1.00	0.97	0.98	0.89	0.95	0.93	0.29	-0.08	0.96	0.94	0.12	0.97	0.57
Construccion	0.98	-0.30	0.09	0.40	0.99	0.97	1.00	0.99	0.96	0.98	0.98	0.34	-0.11	0.99	0.99	0.03	0.98	0.56
CTH	1.00	-0.33	0.10	0.36	0.99	0.98	0.99	1.00	0.93	0.98	0.97	0.33	-0.01	0.99	0.97	0.09	0.99	0.58
Infor	0.94	-0.26	0.11	0.30	0.96	0.89	0.96	0.93	1.00	0.97	0.99	0.31	-0.11	0.96	0.99	-0.07	0.91	0.41
AFS	0.99	-0.31	0.10	0.32	0.99	0.95	0.98	0.98	0.97	1.00	0.99	0.32	-0.03	0.99	0.99	0.09	0.98	0.54
APT	0.98	-0.30	0.11	0.33	0.99	0.93	0.98	0.97	0.99	0.99	1.00	0.33	-0.08	0.99	1.00	-0.01	0.96	0.48
TasaActividad	0.33	-0.73	0.47	0.09	0.33	0.29	0.34	0.33	0.31	0.32	0.33	1.00	0.03	0.35	0.33	-0.12	0.33	0.26
TasaParo	0.01	-0.46	0.38	-0.58	-0.06	-0.08	-0.11	-0.01	-0.11	-0.03	-0.08	0.03	1.00	-0.05	-0.10	0.39	0.01	0.10
Ocupados	1.00	-0.33	0.11	0.36	1.00	0.96	0.99	0.99	0.96	0.99	0.99	0.35	-0.05	1.00	0.99	0.05	0.98	0.54
PIB	0.98	-0.30	0.11	0.36	0.99	0.94	0.99	0.97	0.99	0.99	1.00	0.33	-0.10	0.99	1.00	-0.01	0.96	0.47
CANE	0.10	0.02	-0.12	-0.19	0.04	0.12	0.03	0.09	-0.07	0.09	-0.01	-0.12	0.39	0.05	-0.01	1.00	0.15	0.34
TVF	0.99	-0.33	0.08	0.34	0.98	0.97	0.98	0.99	0.91	0.98	0.96	0.33	0.01	0.98	0.96	0.15	1.00	0.67
VS	0.57	-0.25	-0.03	0.19	0.54	0.57	0.56	0.58	0.41	0.54	0.48	0.26	0.10	0.54	0.47	0.34	0.67	1.00

corrplot(R, type="upper", order="hclust",tl.col="black", tl.srt=90)

Las variables más correlacionadas negativamente son Natalidad con Mortalidad (-74%) y luego TasaActividad con Mortalidad (-73%)

fit<-PCA(datos,scale.unit=TRUE,ncp=7,graph=TRUE)

eig<-get_eigenvalue(fit)
knitr::kable(eig, digits =2,caption = "Autovalores")

Autovalores

	eigenvalue	variance.percent	cumulative.variance.percent
Dim.1	11.47	63.70	63.70
Dim.2	2.56	14.23	77.93
Dim.3	1.63	9.08	87.01
Dim.4	0.93	5.19	92.19
Dim.5	0.46	2.54	94.73
Dim.6	0.41	2.30	97.03
Dim.7	0.31	1.71	98.74
Dim.8	0.12	0.65	99.39
Dim.9	0.07	0.41	99.79
Dim.10	0.02	0.11	99.91
Dim.11	0.01	0.05	99.96
Dim.12	0.00	0.02	99.98
Dim.13	0.00	0.01	99.99
Dim.14	0.00	0.00	99.99
Dim.15	0.00	0.00	100.00
Dim.16	0.00	0.00	100.00
Dim.17	0.00	0.00	100.00
Dim.18	0.00	0.00	100.00

fviz_eig(fit,addlabels=TRUE)

fviz_eig(fit,geom="line")+theme_grey()

Vemos que la dimension 1 recoge bastante de la variabilidad con más de 60%. Viendo la gráfica podríamos tomar 3 componentes para recoger casi el 90% de la variabilidad o 4 componentes para tener poco más del 90%.

2. Realizar un análisis de componentes principales sobre la matriz de correlaciones,calculando 7 componentes. Estudiar los valores de los autovalores obtenidos y las gráficas que los resumen. ¿Cuál es el número adecuado de componentes?

a. Mostrar los coeficientes para obtener las componentes principales ¿Cuál es la expresión para calcular la primera Componente en función de las variables originales?

fit<-PCA(datos,scale.unit=TRUE,ncp=7,graph=TRUE)

knitr::kable(fit$svd$V, digits =3,caption = "Autovectores")

## Warning in kable_pipe(x = structure(c("0.294", "-0.106", "0.041", "0.110", : The
## table should have a header (column names)

Autovectores

0.294	0.002	0.050	-0.053	0.016	0.009	-0.067
-0.106	-0.527	0.189	-0.161	-0.024	-0.034	0.195
0.041	0.495	-0.271	-0.110	0.382	0.313	0.588
0.110	-0.365	-0.262	0.435	0.557	0.351	-0.328
0.294	-0.026	0.008	-0.069	0.006	-0.007	-0.017
0.286	-0.045	0.046	0.023	0.150	0.062	0.065
0.293	-0.045	-0.012	-0.026	-0.008	-0.006	0.027
0.293	-0.011	0.049	-0.028	0.028	0.047	-0.068
0.282	-0.042	-0.065	-0.222	-0.070	-0.126	0.051
0.292	-0.016	0.040	-0.092	-0.003	-0.055	0.019
0.291	-0.029	-0.028	-0.142	-0.032	-0.080	0.008
0.114	0.331	-0.363	0.463	-0.133	-0.529	-0.186
-0.014	0.462	0.387	-0.220	0.055	0.304	-0.591
0.294	-0.017	0.002	-0.060	0.001	-0.040	-0.023
0.291	-0.036	-0.037	-0.134	0.009	-0.077	0.009
0.018	0.096	0.657	0.278	0.488	-0.419	0.200
0.292	-0.002	0.100	0.044	-0.047	0.074	-0.006
0.172	0.048	0.290	0.567	-0.503	0.431	0.257

Podemos ver las provincias de Madrid y Barcelona están bien representadas por la componente 1. Dicha componente recoge muchas de las variables, no destacando alguna en particular ya que varias tienen como coeficiente valores alrededor de 0.29.

Donde: CP1:0.041* Poblacion+0.110* Mortalidad+ 0.294* Natalidad+…..0.172* VS

b. Mostar una tabla con las correlaciones de las Variables con las Componentes Principales. Para cada Componente indicar las variables con las que está más correlacionada

var<-get_pca_var(fit)
knitr::kable(var$cor, digits =2,caption = "Correlaciones de la CP con
las variables")

Correlaciones de la CP con las variables

	Dim.1	Dim.2	Dim.3	Dim.4	Dim.5	Dim.6	Dim.7
Poblacion	0.99	0.00	0.06	-0.05	0.01	0.01	-0.04
Mortalidad	-0.36	-0.84	0.24	-0.16	-0.02	-0.02	0.11
Natalidad	0.14	0.79	-0.35	-0.11	0.26	0.20	0.33
IPC	0.37	-0.58	-0.34	0.42	0.38	0.23	-0.18
NumEmpresas	1.00	-0.04	0.01	-0.07	0.00	0.00	-0.01
Industria	0.97	-0.07	0.06	0.02	0.10	0.04	0.04
Construccion	0.99	-0.07	-0.02	-0.03	-0.01	0.00	0.01
CTH	0.99	-0.02	0.06	-0.03	0.02	0.03	-0.04
Infor	0.95	-0.07	-0.08	-0.21	-0.05	-0.08	0.03
AFS	0.99	-0.03	0.05	-0.09	0.00	-0.04	0.01
APT	0.98	-0.05	-0.04	-0.14	-0.02	-0.05	0.00
TasaActividad	0.39	0.53	-0.46	0.45	-0.09	-0.34	-0.10
TasaParo	-0.05	0.74	0.50	-0.21	0.04	0.20	-0.33
Ocupados	1.00	-0.03	0.00	-0.06	0.00	-0.03	-0.01
PIB	0.99	-0.06	-0.05	-0.13	0.01	-0.05	0.00
CANE	0.06	0.15	0.84	0.27	0.33	-0.27	0.11
TVF	0.99	0.00	0.13	0.04	-0.03	0.05	0.00
VS	0.58	0.08	0.37	0.55	-0.34	0.28	0.14

corrplot(var$cor,is.corr=FALSE)

  Podemos ver numéricamente y gráficamente el nivel de las correlaciones donde CP1 contiene la información de las variables relacionadas a desarrollo económico y población, CP2 destaca por la relación inversa con la tasa de mortalidad y directa tasa de natalidad y con tasa de paro. CP3 tiene relación con CANE y la CP4 tiene relaciones media con IPC, Tasa Actividad y Viviendas secundarias (VS).

c. Comentar los gráficos que representan las variables en los planos formados por las componentes, intentando explicar lo que representa cada componente

# Representación gráfica variables 1 y 2
fviz_pca_var(fit, axes = c(1, 2), col.var="cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE )

# Representación gráfica variables 3 y 4
fviz_pca_var(fit, axes = c(3, 4), col.var="cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE )

 La componente 1 representa a: Población,NumEmpresas,Industria,Construccion,CTH,Infor,AFS,APT,Ocupados,PIB,TVF (estas variables estaban muy correlacionadas entre sí)

La componente 2 a representa a:

Tasa Paro, Natalidad, Mortalidad en menor medida y tasa actividad

La componente 3 a representa a: 

CANE , Tasa Paro en menor medida Tasa Actividad

La componente 4 a representa a:

IPC y VS

d. Mostrar la tabla y los gráficos que nos muestran la proporción de la varianza de cada variable que es explicado por cada componente. ¿Cuál de las variables es la que está peor explicada?

knitr::kable(var$cos2, digits =2,caption = "Cosenos al cuadrado")

Cosenos al cuadrado

	Dim.1	Dim.2	Dim.3	Dim.4	Dim.5	Dim.6	Dim.7
Poblacion	0.99	0.00	0.00	0.00	0.00	0.00	0.00
Mortalidad	0.13	0.71	0.06	0.02	0.00	0.00	0.01
Natalidad	0.02	0.63	0.12	0.01	0.07	0.04	0.11
IPC	0.14	0.34	0.11	0.18	0.14	0.05	0.03
NumEmpresas	0.99	0.00	0.00	0.00	0.00	0.00	0.00
Industria	0.94	0.01	0.00	0.00	0.01	0.00	0.00
Construccion	0.99	0.01	0.00	0.00	0.00	0.00	0.00
CTH	0.98	0.00	0.00	0.00	0.00	0.00	0.00
Infor	0.91	0.00	0.01	0.05	0.00	0.01	0.00
AFS	0.98	0.00	0.00	0.01	0.00	0.00	0.00
APT	0.97	0.00	0.00	0.02	0.00	0.00	0.00
TasaActividad	0.15	0.28	0.22	0.20	0.01	0.12	0.01
TasaParo	0.00	0.55	0.25	0.05	0.00	0.04	0.11
Ocupados	0.99	0.00	0.00	0.00	0.00	0.00	0.00
PIB	0.97	0.00	0.00	0.02	0.00	0.00	0.00
CANE	0.00	0.02	0.70	0.07	0.11	0.07	0.01
TVF	0.97	0.00	0.02	0.00	0.00	0.00	0.00
VS	0.34	0.01	0.14	0.30	0.12	0.08	0.02

# Representación gráfica de los cosenos 
corrplot(var$cos2,is.corr=FALSE)

#Porcentaje de variabilidad explicada por las 4 CP 
fviz_cos2(fit,choice="var",axes=1:4)

La variables con menos representación en las 4 componentes es IPC ya que el coseno (correlaciones al cuadrado) alcanza el 75% mientras que por ejemplo NumEmpresas alcanza casi el 100%.

e. Mostrar la tabla y los gráficos que nos muestran el porcentaje de la varianza de cada Componente que es debido a cada variable. ¿Que variables contribuyen más a cada Componente?

knitr::kable(var$contrib, digits =2,caption = "Contribuciones")

Contribuciones

	Dim.1	Dim.2	Dim.3	Dim.4	Dim.5	Dim.6	Dim.7
Poblacion	8.62	0.00	0.25	0.29	0.03	0.01	0.45
Mortalidad	1.13	27.79	3.57	2.60	0.06	0.11	3.79
Natalidad	0.17	24.54	7.33	1.20	14.60	9.83	34.58
IPC	1.21	13.35	6.88	18.93	31.00	12.30	10.79
NumEmpresas	8.65	0.07	0.01	0.48	0.00	0.00	0.03
Industria	8.16	0.20	0.22	0.05	2.25	0.38	0.42
Construccion	8.60	0.21	0.01	0.07	0.01	0.00	0.07
CTH	8.58	0.01	0.24	0.08	0.08	0.22	0.46
Infor	7.92	0.18	0.42	4.91	0.50	1.58	0.26
AFS	8.55	0.03	0.16	0.84	0.00	0.30	0.03
APT	8.45	0.09	0.08	2.01	0.10	0.64	0.01
TasaActividad	1.31	10.93	13.16	21.44	1.77	27.93	3.46
TasaParo	0.02	21.30	15.00	4.85	0.31	9.25	34.98
Ocupados	8.67	0.03	0.00	0.36	0.00	0.16	0.06
PIB	8.46	0.13	0.14	1.79	0.01	0.59	0.01
CANE	0.03	0.93	43.13	7.75	23.82	17.58	3.99
TVF	8.50	0.00	1.00	0.19	0.22	0.54	0.00
VS	2.97	0.23	8.42	32.16	25.26	18.56	6.62

corrplot(var$contrib,is.corr=FALSE)

#Contribución de las variables a la Componente 1
fviz_contrib (fit, choice="var", axes=1, top= 10)

#Contribución de las variables a la Componente 2
fviz_contrib (fit, choice="var", axes=2, top= 10)

#Contribución de las variables a la Componente 3
fviz_contrib (fit, choice="var", axes=3, top= 10)

#Contribución de las variables a la Componente 4
fviz_contrib (fit, choice="var", axes=4, top= 10)

Respecto a la componente 1 ésta se representa por 10 variables de forma casi equitativa: Ocupados, NumEmpresas, Poblacion,Construccion,CTH - CTH. Comercio, transporte y hostelería (nº empresas)-, AFS -AFS. Actividades financieras y de seguros (nº empresas), TVF -TVF. Censo 2011: Total viviendas familiares-, PIB, APT -APT. Actividades profesionales y técnicas (nº empresas)-, Industria.

Respecto a la componente 2 en ésta destacan 5 variables: Mortalidad, Natalidad, TasaParo, IPC, Tasa Actividad.

Respecto a la componente 3 en ésta destacan 1 variable: CANE -Censo Agrario Número de Explotaciones-, en menor medida le siguen: TasaParo, TasaActividad, VS -Censo 2011: Viviendas secundarias-,Nataidad, IPC, etc.

Respecto a la componente 4 en ésta destacan VS -Censo 2011: Viviendas secundarias-,TasaActividad, IPC, etc.

f. Sobre los gráficos que representan las observaciones en los nuevos ejes y el gráfico Biplot., teniendo en cuenta la posición de las provincias en el gráfico ¿Comentar las provincias que tienen una posición más destacada en cada ¿componente, en positivo o negativo, ¿Qué significa esto en términos socioeconómicos para estas provincias?

fviz_pca_ind(fit,axes = c(1, 2), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), repel = TRUE)

Observamos que MAdrid y Barcelona destacan en la componente 1 relacionada con números de empresas y población principalmente. Se podría decir que son ciudades más desarrolladas en cuanto a esas variables. Luego Melilla, Ceuta, Almería son 3 provincias que destacan en la componente 2 relacionada con Mortalidad, Natalidad, TasaParo, IPC, Tasa Actividad. Se podría decir que tienen baja mortalidad con buena tasa de natalidad pero poco desarrolladas.

fviz_pca_ind(fit,axes = c(2, 3), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)

fviz_pca_ind(fit,axes = c(1, 3), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)

Las provincias de Jaen y Valencia destacan respecto a las demás por su representación en la componente 3 relacionada con CANE -Censo Agrario Número de Explotaciones. Se podría decir que son provincias agrícolas pero Valencia es más desarrollada por su posición en el componente 1.

fviz_pca_ind(fit,axes = c(3, 4), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)

fviz_pca_ind(fit,axes = c(1, 4), col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)

Las provincias de Alicante y Valencia destacan en las componentes 3 y 4 donde la 3 está relacionada con CANE (Censo Agrario Número de Explotaciones) y la 4 con VS (Viviendas secundarias). SE podría decir Por otro lado está la provincia de Balears que tiene una representación similar en la componente 4 pero en el extremo opuesto de la componente 3.

g. Si tuviéramos que construir un índice que valore de forma conjunta el desarrollo económico de una provincia, como se podría construir utilizando una combinación lineal de todas las variables. ¿Cuál sería el valor de dicho índice en Madrid? ¿Cual sería su valor en Melilla?

El índice podría estar representado por la componente 1 ya que esta es una representación lineal de las variables que tienen relacion con el desarrollo económico, como vimos: CP1:0.041* Poblacion+0.110* Mortalidad+ 0.294* Natalidad+…..0.172* VS

ind<-get_pca_ind(fit) 
knitr::kable(ind$coord, digits =3,caption = "Valores de los individuos en las Cp")

Valores de los individuos en las Cp

	Dim.1	Dim.2	Dim.3	Dim.4	Dim.5	Dim.6	Dim.7
Albacete	-1.410	0.473	0.096	-0.458	0.131	-0.379	-0.033
Alicante	3.384	0.540	1.919	2.420	-1.938	1.799	0.821
Almería	-0.617	2.614	0.208	-0.142	-0.042	0.050	-0.083
Álava	-1.444	-0.001	-2.032	-0.113	0.468	0.094	0.288
Asturias	-0.204	-1.953	1.298	-0.714	-0.369	0.017	0.362
Badajoz	-1.048	1.168	1.796	-0.854	0.075	-0.575	0.100
Balears	1.526	0.260	-2.519	2.364	0.481	-0.567	-0.652
Barcelona	13.683	-1.612	-0.867	-0.279	1.040	0.765	-0.500
Bizkaia	0.576	-1.508	-1.180	-0.383	0.798	0.466	-0.213
Burgos	-1.202	-1.550	-0.892	0.989	0.602	0.532	-0.458
Cantabria	-0.849	-1.126	-0.594	0.401	-0.131	0.391	-0.103
Castellón	-0.690	0.821	0.518	0.382	-0.548	-0.294	0.627
Ceuta	-2.125	3.326	-1.811	-1.165	0.298	0.648	0.029
Ciudad Real	-1.392	0.815	1.819	-0.774	0.216	-0.565	-0.219
Coruña	0.635	-1.442	0.759	0.244	0.258	-0.046	0.293
Cuenca	-2.132	-0.569	1.048	-0.932	-0.478	-0.080	0.246
Cáceres	-1.503	-0.180	1.269	-0.223	-0.041	0.074	-0.416
Cádiz	0.128	1.771	0.369	-0.249	-0.259	1.273	-1.427
Córdoba	-0.594	0.811	1.292	-0.169	1.084	-0.014	-0.662
Gipuzkoa	-0.281	-1.485	-1.879	0.266	1.184	0.484	-0.209
Girona	0.388	0.544	-1.387	1.638	-0.629	0.508	0.101
Granada	-0.072	1.124	1.511	0.500	0.723	-0.090	-0.362
Guadalajara	-1.408	1.542	-1.849	0.906	-0.788	-1.017	-0.304
Huelva	-1.265	1.168	0.013	-0.327	0.073	0.930	-0.731
Huesca	-1.776	-0.984	-0.587	0.304	-0.290	-0.793	0.331
Jaén	-1.221	1.424	3.407	-0.479	1.428	-1.000	-0.265
León	-1.464	-2.016	0.877	-0.809	-0.240	0.665	-0.113
Lleida	-0.835	-0.136	-1.472	1.185	0.741	-0.924	0.136
Lugo	-1.826	-2.785	0.871	-0.353	0.324	-0.161	0.398
Madrid	16.778	-0.366	-0.849	-2.365	-0.880	-0.974	0.424
Melilla	-2.218	4.782	-1.905	-2.231	0.714	1.410	1.854
Murcia	1.522	1.442	0.580	0.901	0.437	0.406	0.595
Málaga	2.006	1.325	0.869	1.104	-0.357	0.738	-0.349
Navarra	-0.653	0.078	-1.096	-0.081	0.229	-0.704	0.612
Ourense	-1.965	-2.858	1.098	-1.204	-0.325	0.888	0.142
Palencia	-2.122	-1.951	-0.695	-0.142	0.050	0.041	-0.395
Palmas	0.092	1.857	-0.330	-0.824	-1.375	-0.550	-1.284
Pontevedra	0.036	-0.607	0.052	-0.328	-0.016	0.419	-0.310
Rioja	-1.383	-0.484	-1.354	0.288	0.201	-0.243	0.226
Salamanca	-1.612	-1.425	-0.121	-0.086	-0.577	-0.243	0.306
Santa Cruz	-0.029	1.573	-0.126	-0.432	-1.560	-0.747	-0.941
Segovia	-1.931	-1.015	-1.110	0.263	-0.266	-0.399	0.197
Sevilla	1.948	1.775	0.712	-0.546	0.549	-0.205	-0.509
Soria	-2.399	-1.857	-0.778	-0.503	-0.656	-0.420	0.352
Tarragona	0.175	1.040	-0.102	1.512	-0.537	-0.225	0.323
Teruel	-2.185	-1.082	-0.351	-0.413	-0.516	-0.404	0.525
Toledo	-0.461	1.449	0.812	0.463	0.047	-0.764	0.144
Valencia	4.770	0.360	2.961	2.349	0.919	-0.284	0.907
Valladolid	-1.007	-0.704	-1.052	0.196	0.290	0.082	-0.312
Zamora	-2.287	-3.169	0.578	-0.622	0.167	0.635	-0.282
Zaragoza	0.115	-0.237	-0.156	0.068	0.142	-0.822	0.675
Ávila	-2.152	-0.982	0.365	-0.545	-0.851	0.171	0.118

Madrid tnedría una valor de 16.778, le seguiría Barcelon con 13.683. Melilla tendría un valor de -2.218, es decir bajo desarrollo, comparado a la media=0

4. Representar un mapa de calor de la matriz de datos, estandarizado y sin estandarizar

para ver si se detectan inicialmente grupos de provincias.

tabla1<-summary(datos)
knitr::kable(tabla1, caption = "Tabla resumen de las variables") 

Tabla resumen de las variables

	Poblacion	Mortalidad	Natalidad	IPC	NumEmpresas	Industria	Construccion	CTH	Infor	AFS	APT	TasaActividad	TasaParo	Ocupados	PIB	CANE	TVF	VS
	Min. : 84509	Min. : 5.820	Min. : 5.550	Min. :100.6	Min. : 3749	Min. : 75	Min. : 309	Min. : 2030	Min. : 35.0	Min. : 50.0	Min. : 504	Min. :47.41	Min. :11.95	Min. : 24.6	Min. : 1397441	Min. : 3	Min. : 26233	Min. : 200
	1st Qu.: 322203	1st Qu.: 7.855	1st Qu.: 7.700	1st Qu.:101.9	1st Qu.: 22822	1st Qu.: 1704	1st Qu.: 2972	1st Qu.: 9243	1st Qu.: 185.5	1st Qu.: 486.8	1st Qu.: 3091	1st Qu.:55.45	1st Qu.:15.39	1st Qu.: 132.4	1st Qu.: 6509393	1st Qu.: 9758	1st Qu.: 211628	1st Qu.: 38941
	Median : 614723	Median : 9.120	Median : 8.975	Median :102.3	Median : 38000	Median : 2516	Median : 5070	Median : 15488	Median : 369.5	Median : 813.5	Median : 5440	Median :57.79	Median :19.51	Median : 222.4	Median : 11883640	Median :14037	Median : 335934	Median : 56412
	Mean : 899449	Mean : 9.379	Mean : 8.839	Mean :102.4	Mean : 61286	Mean : 3808	Mean : 7805	Mean : 23741	Mean : 1131.9	Mean : 1378.3	Mean : 10854	Mean :57.84	Mean :21.17	Mean : 347.1	Mean : 20275145	Mean :19035	Mean : 484781	Mean : 70799
	3rd Qu.:1019030	3rd Qu.:10.688	3rd Qu.: 9.610	3rd Qu.:102.7	3rd Qu.: 65083	3rd Qu.: 4106	3rd Qu.: 8350	3rd Qu.: 27567	3rd Qu.: 868.2	3rd Qu.: 1429.2	3rd Qu.: 10627	3rd Qu.:60.07	3rd Qu.:27.75	3rd Qu.: 389.8	3rd Qu.: 21242697	3rd Qu.:26020	3rd Qu.: 532066	3rd Qu.: 80625
	Max. :6454440	Max. :14.360	Max. :19.330	Max. :104.8	Max. :508612	Max. :27416	Max. :59661	Max. :158331	Max. :19058.0	Max. :12357.0	Max. :123863	Max. :68.69	Max. :37.18	Max. :2806.4	Max. :198652445	Max. :68037	Max. :2894679	Max. :326705

heatmaply(datos, seriate = "mean", row_dend_left = TRUE,  plot_method = "plotly")

#Al ser interactivo no se puede exportar a pdf y usar la alternativa de abajo
#ggheatmap(as.matrix(datos),seriate="mean")

No apreciamos un matiz de colores, casi en todas las variables los valores están muy juntos. Destacan Barcelona y Madrid por sus colores muy claros en el PIB.

#Calculamos las distancias con los valores sin estandarizar #Mostramos las primeras seis filas dela matriz de distancias

d <- dist(datos, method = "euclidean") # distance matrix
d6<-as.matrix(d)[1:6, 1:6]
knitr::kable(d6, digits =2,caption = "Distancias") 

Distancias

	Albacete	Alicante	Almería	Álava	Asturias	Badajoz
Albacete	0	24971242	4687257	3481471.5	14555211	3362039.7
Alicante	24971242	0	20284171	21510859.3	10424490	21610942.1
Almería	4687257	20284171	0	1277176.4	9869791	1328833.4
Álava	3481472	21510859	1277176	0.0	11088936	452219.3
Asturias	14555211	10424490	9869791	11088935.7	0	11197887.0
Badajoz	3362040	21610942	1328833	452219.3	11197887	0.0

#Representamos gráficamente la matriz de distancias
fviz_dist(d, show_labels = TRUE)

#Reordenamos para agrupar las observaciones que están más próximas y visualizar los posibles clusters

ggheatmap(as.matrix(d), seriate="mean")

ggheatmap(as.matrix(d), seriate="OLO")

#según el criterio de ward #Dibujamos el dendograma correspondiente

res.hc <- hclust(d, method="ward.D2") 

fviz_dend(res.hc, cex = 0.5)

Estandarizamos

#first 6 rows

datos_ST <- scale(datos)
head(datos_ST, nrow = 6)

##           Poblacion  Mortalidad   Natalidad         IPC NumEmpresas   Industria
## Albacete -0.4352968  0.01459982  0.08469908 -0.64825299 -0.38207162 -0.09851058
## Alicante  0.8394624 -0.65028156 -0.14907757 -0.05020505  0.76394056  1.28047827
## Almería  -0.1713258 -1.16426788  1.20215149 -1.09373769 -0.23154132 -0.33476077
## Álava    -0.5003190 -0.78231475  0.66446518  0.47949457 -0.46109285 -0.36436969
## Asturias  0.1406112  1.31135430 -1.20574805 -0.34190598  0.06810524 -0.06455350
## Badajoz  -0.1806466  0.07590094  0.05664588 -1.60390921 -0.23913080 -0.15503670
##          Construccion        CTH      Infor         AFS         APT
## Albacete  -0.41788262 -0.4185734 -0.3160749 -0.36468248 -0.37127978
## Alicante   0.91784057  0.9603758  0.2410627  0.66074991  0.44165900
## Almería   -0.23074771 -0.1841696 -0.2567408 -0.20997321 -0.24571463
## Álava     -0.49034966 -0.5363553 -0.2711553 -0.49521843 -0.36819211
## Asturias   0.06017071  0.1426303 -0.1156126  0.03224349 -0.01252221
## Badajoz   -0.30607906 -0.1763484 -0.2681383 -0.20803934 -0.27536604
##          TasaActividad   TasaParo    Ocupados         PIB       CANE        TVF
## Albacete   -0.02968476  0.3022945 -0.41600241 -0.39787472  0.1299067 -0.4998087
## Alicante    0.09152801  0.3180755  0.69921672  0.36202242  0.4859572  1.4674767
## Almería     0.69017067  1.4213109 -0.23174345 -0.25526238  0.2740791 -0.1667593
## Álava       0.00494746 -1.1251688 -0.44026866 -0.29168563 -1.0754084 -0.6116959
## Asturias   -1.58813466 -0.6029611  0.08618552  0.04562699  0.3417147  0.2400641
## Badajoz    -0.45516632  1.2132886 -0.25189677 -0.29579447  1.2898744 -0.2087637
##                   VS
## Albacete -0.70153382
## Alicante  4.42670296
## Almería   0.02917605
## Álava    -1.05533357
## Asturias  0.04239186
## Badajoz  -0.36946059

#Calculamos las distancias con los valores estandarizados

d_st <- dist(datos_ST, method = "euclidean") # distance matrix
d_st6<-as.matrix(d_st)[1:6, 1:6]
knitr::kable(d_st6, digits =2,caption = "Distancias") 

Distancias

	Albacete	Alicante	Almería	Álava	Asturias	Badajoz
Albacete	0.00	6.60	2.37	2.45	3.11	1.92
Alicante	6.60	0.00	6.07	7.35	5.90	6.35
Almería	2.37	6.07	0.00	3.68	4.77	2.39
Álava	2.45	7.35	3.68	0.00	4.20	4.22
Asturias	3.11	5.90	4.77	4.20	0.00	3.37
Badajoz	1.92	6.35	2.39	4.22	3.37	0.00

#Visualizamos

fviz_dist(d_st)

#Barcelona y MAdrid son diferentes a los demas

heatmaply(as.matrix(d_st), seriate = "OLO", row_dend_left = TRUE,  plot_method = "plotly")

res.hc_st <- hclust(d_st, method="ward.D2") 
fviz_dend(res.hc_st, cex = 0.5)

5. Realizar un análisis Jerárquico de clusters para determinar si existen grupos de provincias con comportamiento similar.

a. A la vista del dendrograma ¿Cuántos clusters recomendarías?

#Seleccionaremos 4 grupos
grp<-cutree(res.hc_st, k=4)
head(grp,n=4)

## Albacete Alicante  Almería    Álava 
##        1        2        3        1

#Número de miembros en cada cluster
knitr::kable(table(grp),caption="Numero de individuos por cluster")

Numero de individuos por cluster

grp	Freq
1	31
2	2
3	17
4	2

#podemos ver las provincias de los clusters
rownames(datos)[grp == 1]

##  [1] "Albacete"    "Álava"       "Asturias"    "Balears"     "Bizkaia"    
##  [6] "Burgos"      "Cantabria"   "Coruña"      "Cuenca"      "Cáceres"    
## [11] "Gipuzkoa"    "Girona"      "Guadalajara" "Huesca"      "León"       
## [16] "Lleida"      "Lugo"        "Navarra"     "Ourense"     "Palencia"   
## [21] "Pontevedra"  "Rioja"       "Salamanca"   "Segovia"     "Soria"      
## [26] "Tarragona"   "Teruel"      "Valladolid"  "Zamora"      "Zaragoza"   
## [31] "Ávila"

rownames(datos)[grp == 2]

## [1] "Alicante" "Valencia"

rownames(datos)[grp == 3]

##  [1] "Almería"     "Badajoz"     "Castellón"   "Ceuta"       "Ciudad Real"
##  [6] "Cádiz"       "Córdoba"     "Granada"     "Huelva"      "Jaén"       
## [11] "Melilla"     "Murcia"      "Málaga"      "Palmas"      "Santa Cruz" 
## [16] "Sevilla"     "Toledo"

rownames(datos)[grp == 4]

## [1] "Barcelona" "Madrid"

b. Representar los individuos agrupados según el número de clusters elegido.

fviz_dend(res.hc_st, k = 4, # Cut in four groups
          cex = 0.5, # label size
          k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
          color_labels_by_k = TRUE, # color labels by groups
          rect = TRUE) # Add rectangle around groups

fviz_cluster(list(data = d_st, cluster = grp),
             palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"), 
             ellipse.type = "convex", # Concentration ellipse
             repel = TRUE, # Avoid label overplotting (slow)
             show.clust.cent = FALSE, ggtheme = theme_minimal())

Vemos cierto traslape en los clusters 2 y 3

# class(datos_ST)
# 
#datos[rownames(datos)!='Barcelona',]
#datos[!rownames(datos)%in%c('Barcelona','Madrid'),]

c. ¿Qué número óptimo de clusters nos indican los criterios Silhoutte y de Elbow?

#para clustering jeraquico:

#Determinación delnúmero óptimo de clusters
# Elbow method
fviz_nbclust(datos_ST, hcut, method = "wss") +
  geom_vline(xintercept =3, linetype = 2)+
  labs(subtitle = "Elbow method")

# Silhouette method
fviz_nbclust(datos_ST, hcut, method = "silhouette")+
  labs(subtitle = "Silhouette method")

En ambos método se ve que existen 2 cluster claramente diferenciados, quizá si retiramos a Madrid y Barcelona nos podrían salir más grupos.

datos_sin<-datos[!rownames(datos)%in%c('Barcelona','Madrid'),]
datos_ST_sin <- scale(datos_sin)
d_st_sin <- dist(datos_ST_sin, method = "euclidean")

res.hc_st_sin <- hclust(d_st_sin, method="ward.D2") 
fviz_dend(res.hc_st_sin, cex = 0.5)

#para clustering jeraquico:

#Determinación delnúmero óptimo de clusters
# Elbow method
fviz_nbclust(datos_ST_sin, hcut, method = "wss") +
  geom_vline(xintercept =3, linetype = 2)+
  labs(subtitle = "Elbow method")

# Silhouette method
fviz_nbclust(datos_ST_sin, hcut, method = "silhouette")+
  labs(subtitle = "Silhouette method")

Entonces nos quedamos con 2 cluster más el cluster Barcelona-Madrid que habíamos retirado serían 3 clusters

d. Con el número de clusters decidido en el apartado anterior realizar un agrupamiento no jerárquico.

RNGkind(sample.kind = "Rejection")
set.seed(1234)

km.res <- kmeans(datos_ST, 3)
head(km.res$cluster, 20)

##    Albacete    Alicante     Almería       Álava    Asturias     Badajoz 
##           2           1           1           2           2           1 
##     Balears   Barcelona     Bizkaia      Burgos   Cantabria   Castellón 
##           1           3           2           2           2           1 
##       Ceuta Ciudad Real      Coruña      Cuenca     Cáceres       Cádiz 
##           1           1           2           2           2           1 
##     Córdoba    Gipuzkoa 
##           1           2

print(km.res)

## K-means clustering with 3 clusters of sizes 23, 27, 2
## 
## Cluster means:
##     Poblacion Mortalidad  Natalidad        IPC NumEmpresas   Industria
## 1  0.04846141 -0.7378253  0.5361929 -0.4678304 -0.01772688 -0.02758061
## 2 -0.36789805  0.6953741 -0.4947207  0.2733647 -0.32333852 -0.30172394
## 3  4.40931744 -0.9025593  0.5125104  1.6896263  4.56892924  4.39045012
##   Construccion         CTH      Infor         AFS         APT TasaActividad
## 1  -0.03934538  0.03456157 -0.1129017 -0.00473118 -0.05627375     0.5005539
## 2  -0.30171894 -0.35670840 -0.2505702 -0.32596935 -0.29539322    -0.5182922
## 3   4.52567761  4.41810542  4.6810676  4.45499479  4.63495671     1.2405756
##     TasaParo     Ocupados         PIB       CANE         TVF         VS
## 1  0.8314882 -0.001142574 -0.06862329  0.4076102  0.08632346  0.3701857
## 2 -0.6613562 -0.333431668 -0.28485815 -0.2959366 -0.38534053 -0.4253843
## 3 -0.6338058  4.514467117  4.63475280 -0.6923738  4.20937736  1.4855534
## 
## Clustering vector:
##    Albacete    Alicante     Almería       Álava    Asturias     Badajoz 
##           2           1           1           2           2           1 
##     Balears   Barcelona     Bizkaia      Burgos   Cantabria   Castellón 
##           1           3           2           2           2           1 
##       Ceuta Ciudad Real      Coruña      Cuenca     Cáceres       Cádiz 
##           1           1           2           2           2           1 
##     Córdoba    Gipuzkoa      Girona     Granada Guadalajara      Huelva 
##           1           2           1           1           1           1 
##      Huesca        Jaén        León      Lleida        Lugo      Madrid 
##           2           1           2           2           2           3 
##     Melilla      Murcia      Málaga     Navarra     Ourense    Palencia 
##           1           1           1           2           2           2 
##      Palmas  Pontevedra       Rioja   Salamanca  Santa Cruz     Segovia 
##           1           2           2           2           1           2 
##     Sevilla       Soria   Tarragona      Teruel      Toledo    Valencia 
##           1           2           1           2           1           1 
##  Valladolid      Zamora    Zaragoza       Ávila 
##           2           2           2           2 
## 
## Within cluster sum of squares by cluster:
## [1] 214.26326  95.53694  13.70956
##  (between_SS / total_SS =  64.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

i. Representar los clusters formados en los planos de las Componentes principales. Relacionar la posición de cada cluster en el plano con lo que representa cada componente principal.

# Visualize clusters using factoextra
fviz_cluster(km.res, datos_ST)

Apreciamos que el cluster MAdrid-Barcelona está muy a la derecha de la media en el componente 1 , esta componente estaba representado por las variables de desarrollo económico y población. Respecto a la componente 2 hay 2 grupos los que están por encima y por debajo de la media, esta componente está representado por las variables de tasa de paro y natalidad principalmente.

#Determinación delnúmero óptimo de clusters
# Elbow method
fviz_nbclust(datos_ST, kmeans, method = "wss") +
  geom_vline(xintercept =3, linetype = 2)+
  labs(subtitle = "Elbow method")

# Silhouette method
fviz_nbclust(datos_ST, kmeans, method = "silhouette")+
  labs(subtitle = "Silhouette method")

ii. Evaluar la calidad de los clusters

sil <- silhouette(km.res$cluster, dist(datos_ST))
rownames(sil) <- rownames(datos)
head(sil[, 1:3])

##          cluster neighbor  sil_width
## Albacete       2        1 0.23404690
## Alicante       1        2 0.12861643
## Almería        1        2 0.23985301
## Álava          2        1 0.33700472
## Asturias       2        1 0.38504449
## Badajoz        1        2 0.03338686

fviz_silhouette(sil)

##   cluster size ave.sil.width
## 1       1   23          0.08
## 2       2   27          0.41
## 3       3    2          0.66

En el cluster 1 encontramos provincias con silueta negativa por lo que podríamos pensar que están mal clasificadas. Las provincias de Albacete, Navarra, Alava y otra más están en la media del componente 2 y podrían estar generando dichas siluetas.

Probemos otro número de k.

RNGkind(sample.kind = "Rejection")
set.seed(1234)
km.res_reducido <- kmeans(datos_ST, 2)
fviz_cluster(km.res_reducido, datos_ST)

sil <- silhouette(km.res_reducido$cluster, dist(datos_ST))
rownames(sil) <- rownames(datos)
fviz_silhouette(sil)

##   cluster size ave.sil.width
## 1       1    2          0.67
## 2       2   50          0.76

Con k=2 no hay siluetas negativas sin embargo tener sólo 2 clusters puede resultar en ser poco útil por lo que caracterizaremos 3.

e. Explicar las provincias que forman cada uno de los clusters y comentar cuales son las características socioeconómicas que las hacen pertenecer a dicho cluster.

EsT_Clus<-aggregate(datos, by=list(km.res$cluster),mean)
knitr::kable(EsT_Clus, digits =2,caption = "Estadísticos de los clusters") 

Estadísticos de los clusters

Group.1	Poblacion	Mortalidad	Natalidad	IPC	NumEmpresas	Industria	Construccion	CTH	Infor	AFS	APT	TasaActividad	TasaParo	Ocupados	PIB	CANE	TVF	VS
1	955387.7	7.81	9.99	101.97	59681.48	3674.57	7392.70	24784.09	795.09	1368.52	9705.30	59.86	26.97	346.53	18026222	24850.17	531212.2	92199.61
2	474785.2	10.85	7.78	102.57	32017.52	2350.56	4644.67	12977.74	384.41	704.07	4826.37	55.74	16.56	184.95	10939771	14812.22	277517.3	46208.07
3	5989112.0	7.46	9.94	103.73	474865.50	25012.00	55205.50	157055.00	15096.00	10593.00	105424.00	62.86	16.75	2542.35	172165306	9156.00	2748888.0	156678.50

Finalmente vemos que el cluster 3 tiene alta población y altos números de empresas de los diferentes rubros. Al ser tan marcada las diferencias con respecto al resto pareciera que no hubiesen diferencia significativa entre los cluster 1 y 2 pero sí las hay en todas las variables (donde hay poca es en tasaactividad 59.86 vs 55.74) por lo que se debe tener cuidado en este tipo de casos.